home *** CD-ROM | disk | FTP | other *** search
- # jprefixmatch.tcl - utility procedures for prefix matching/expansion
- #
- # Copyright 1992-1994 by Jay Sekora. All rights reserved, except
- # that this file may be freely redistributed in whole or in part
- # for non¡profit, noncommercial use.
- ######################################################################
-
- ######################################################################
- # j:longest_match l - longest common initial string in list l
- # used by tab-expansion in filename dialogue box
- ######################################################################
- # this needs commenting desperately
-
- proc j:longest_match { l } {
- case [llength $l] in {
- {0} { return {} }
- {1} { return [lindex $l 0] }
- }
- set first [lindex $l 0]
- set matchto [expr {[string length $first] - 1}]
- for {set i 1} {$i < [llength $l]} {incr i} {
- set current [lindex $l $i]
- # if they don't match up to matchto, find new matchto
- if { [string compare \
- [string range $first 0 $matchto] \
- [string range $current 0 $matchto]] } {
- # loop, decreasing matchto until the strings match that far
- for {} \
- {[string compare \
- [string range $first 0 $matchto] \
- [string range $current 0 $matchto]] } \
- {incr matchto -1 } \
- {} ;# don't need to do anything in body
- } ;# end if they didn't already match up to matchto
- } ;# end for each element in list
- if {$matchto < 0} then {
- return {}
- } else {
- return [string range $first 0 $matchto]
- }
- }
-
- ######################################################################
- # j:expand_filename f - expand filename prefix as much as possible
- # (for use in file dialogue boxes)
- ######################################################################
- # note: if the filename has *, ?, or [...] in it, they will be used
- # as part of the globbing pattern. i declare this a feature.
-
- proc j:expand_filename { f } {
- set glob_list [glob -nocomplain "${f}*"]
- set expansion [j:longest_match $glob_list]
- if {$expansion == ""} {return $f}
- # make sure it doesn't already end in "/":
- set expansion [string trimright $expansion "/"]
- # append / if the expansion is (1) unique, ie, not a prefix of another
- # file, and (2) a directory:
- if {[file isdirectory $expansion] && [llength $glob_list] == 1} {
- append expansion "/"
- }
- return $expansion
- }
-
-